home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / bbs / rchat401.zip / RCSUB401.BAS < prev    next >
BASIC Source File  |  1992-09-14  |  2KB  |  63 lines
  1. '
  2. ' RCSUB401  --  Or, RBBS-Chat, release 4.01.  Error corrected subprograms
  3. '               an internode chat program..
  4. '
  5. '  Not the worlds prettiest, or cleanest code.. but I'm under no illusions..
  6. '
  7. '  Copyright 1989-1990 By John Morris  All Rights Reserved
  8. '
  9. '  I'm not a big fan of global variables, but here goes..
  10. '
  11. '  $INCLUDE: 'RBBS-VAR.MOD'   'RBBS-VAR.BAS minus the DEF FN...
  12. '
  13.    DEFINT A - Z
  14.  
  15. REM *************************************************************
  16. REM ** The following are needed by only 2 or 3 subprograms, so,**
  17. REM ** they are declared COMMON, and then SHARED only in some  **
  18. REM ** of the subprgms.. the fewer that have access the better **
  19. REM *************************************************************
  20.  
  21. 59950 SUB OpenWrk10 (ChatFileName$) STATIC
  22.       ON ERROR GOTO RCERR
  23.       IF ZShareIt THEN
  24.          OPEN ChatFileName$ FOR RANDOM ACCESS READ WRITE SHARED AS #10 LEN = 128
  25.        ELSE
  26.          OPEN "R", 10, ChatFileName$, 128
  27.       END IF
  28.       END SUB
  29.  
  30.  
  31. 59960 SUB Update10 (Record, ReadIt) STATIC                           ' CHAT0902
  32.       ON ERROR GOTO RCERR                                            ' CHAT0902
  33.       IF ReadIt THEN                                                 ' CHAT0902
  34.          GET 10, Record
  35.        ELSE
  36.          PUT 10, Record
  37.       END IF                                                         ' CHAT0902
  38.       END SUB                                                        ' CHAT0902
  39.  
  40. RCERR:                                  ' RBBS Chat Error Routineski ' CHAT0902
  41. '
  42. ' * OpenWrk9 Error Checking
  43. '
  44.       IF ERL = 59950 AND ERR = 70 THEN
  45.          RESUME NEXT
  46.       END IF
  47. '
  48. ' * LockIt9 Error Checking
  49. '
  50.       IF ERL = 59960 AND ERR = 70 THEN
  51.          RESUME NEXT
  52.       END IF
  53. '
  54. ' * Catch & Report ALL other errors
  55. '
  56.       ZOutTxt$ = "RCSUB401 Untrapped Error" + _
  57.            STR$(ERR) + _
  58.            " in line" + _
  59.            STR$(ERL)
  60.       CALL QuickTPut1 (ZOutTxt$)
  61.       CALL UpdtCalr (ZOutTxt$,2)
  62.       RESUME NEXT
  63.